home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_pas / advisor2 / advisor2.pas
Pascal/Delphi Source File  |  1991-09-23  |  30KB  |  1,026 lines
  1. Program Advisor; (*Timothy W. Lethlean's Not-So-Inferior Version, 9/14/91*)
  2.  
  3. Uses CRT,Dos,Win,Printer;
  4.  
  5. {$M 32768,1,655360}  { Some stupid memory thing }
  6. {$I PGMVar-2.Pas}    { Types/Variables          }
  7. {$I PGMCmd-2.Pas}    { Program Base Commands    }
  8. {$I ADVForms.Pas}    { Modified Forms/Sliders   }
  9.  
  10. Procedure LoadStudents;
  11.  
  12. Var
  13.    S:StudentRec;
  14.    X:Integer;
  15.  
  16. Begin
  17.      Reset (StudentFile);
  18.      X:=0;
  19.      While (Eof(StudentFile)=False) do Begin
  20.            Read(StudentFile,S);
  21.            If S.LName<>'Deleted' then InsertStudent(S,X);
  22.            X:=X+1;
  23.      End;
  24. End;
  25.  
  26. Procedure EditStudent(Cur:Integer; Var C:Boolean);
  27.  
  28. Var
  29.    Ptr:StudentPtr;
  30.    Sex,S220,Dis:String;
  31.    S:StudentRec;
  32.    X,Code:Integer;
  33.  
  34. Begin
  35.      Cls;
  36.      Escape ('ESC - Main Menu   F1 - Save Changes');
  37.      Ptr:=SFirst;
  38.      If Cur<>1 then Begin
  39.         For X:=1 to Cur-1 do Ptr:=Ptr^.Next;
  40.      End;
  41.      Reset (StudentFile);
  42.      Seek (StudentFile,Ptr^.FileLoc);
  43.      Read (StudentFile,S);
  44.         Locate (7,29);
  45.         Write (' Last Name = ',S.LName);
  46.         Locate (8,29);
  47.         Write ('First Name = ',S.FName);
  48.         Locate (9,29);
  49.         Write ('     Class = ',S.Grade:2,'.',S.Class:2);
  50.         Code:=1;
  51.         C:=True;
  52.         Repeat
  53.               Case Code Of
  54.                    0: Code:=4;
  55.                    5: Code:=1;
  56.               End;
  57.               Case Code Of
  58.                    1: SForm(S.LName,7,42,15,Code);
  59.                    2: SForm(S.FName,8,42,15,Code);
  60.                    3: IForm(S.Grade,9,42,12,Code);
  61.                    4: IForm(S.Class,9,45,12,Code);
  62.                   22: C:=True;
  63.               End;
  64.         Until ((Code=20) or (Code=22));
  65.         If Code=20 then C:=False;
  66.         If C=False then Begin
  67.            If S.Sex=True then Sex:='M' else Sex:='F';
  68.            If S.S220=True then S220:='Y' else S220:='N';
  69.            If S.Dis=True then Dis:='Y' else Dis:='N';
  70.            Locate (11,28);
  71.            Write ('        Sex = ',Sex);
  72.            Locate (12,28);
  73.            Write ('220 Student = ',S220);
  74.            Locate (13,28);
  75.            Write (' Disability = ',Dis);
  76.            Code:=1;
  77.            C:=True;
  78.            Repeat
  79.                 Case Code Of
  80.                      4: Code:=1;
  81.                      0: Code:=3;
  82.                 End;
  83.                 Case Code Of
  84.                      1: Repeat
  85.                               Code:=1;
  86.                               SForm(Sex,11,42,1,Code);
  87.                         Until ((Sex='M') or (Sex='m') or (Sex='F') or (Sex='f') or (Code=22));
  88.                      2: Repeat
  89.                               Code:=2;
  90.                               SForm(S220,12,42,1,Code);
  91.                         Until ((S220='N') or (S220='n') or (S220='Y') or (S220='y') or (Code=22));
  92.                      3: Repeat
  93.                               Code:=3;
  94.                               SForm(Dis,13,42,1,Code);
  95.                         Until ((Dis='N') or (Dis='n') or (Dis='Y') or (Dis='y') or (Code=22));
  96.                     22: C:=True;
  97.                 End;
  98.            Until ((Code=20) or (Code=22));
  99.            If Code=20 then C:=False;
  100.            If C=False then Begin
  101.               If ((Sex='M') or (Sex='m')) then S.Sex:=True else S.Sex:=False;
  102.               If ((S220='Y') or (Sex='y')) then S.S220:=True else S.S220:=False;
  103.               If ((Dis='Y') or (Sex='y')) then S.Dis:=True else S.Dis:=False;
  104.               Reset (StudentFile);
  105.               Seek (StudentFile,Ptr^.FileLoc);
  106.               Write (StudentFile,S);
  107.               Ptr^.LName:=S.LName;
  108.               Ptr^.FName:=S.FName;
  109.               Ptr^.Grade:=S.Grade;
  110.               Ptr^.Class:=S.Class;
  111.               Escape ('ESC - Main Menu');
  112.            End;
  113.         End;
  114. End;
  115.  
  116. Procedure DeleteStudent (Cur:Integer);
  117.  
  118. Var
  119.    Ptr:StudentPtr;
  120.    X:Integer;
  121.    S:StudentRec;
  122.  
  123. Begin
  124.      Ptr:=SFirst;
  125.      If Cur<>1 then Begin
  126.         For X:=1 to Cur-1 do Ptr:=Ptr^.Next;
  127.      End;
  128.      Reset (StudentFile);
  129.      Seek (StudentFile,Ptr^.FileLoc);
  130.      Read (StudentFile,S);
  131.      S.LName:='Deleted';
  132.      Seek (StudentFile,Ptr^.FileLoc);
  133.      Write (StudentFile,S);
  134.      SFirst:=Nil;
  135.      SLast:=Nil;
  136.      LoadStudents;
  137. End;
  138.  
  139. Procedure AddStudent (Var C:Boolean);
  140.  
  141. Var
  142.    S:StudentRec;
  143.    Code:Integer;
  144.    Sex,S220,Dis:String;
  145.    D:Boolean;
  146.    R:Char;
  147.  
  148. Begin
  149.      D:=False;
  150.      Repeat
  151.         Cls;
  152.         Escape ('ESC - Main Menu   F1 - Save Entry');
  153.         Locate (7,29);
  154.         Write (' Last Name = ');
  155.         Locate (8,29);
  156.         Write ('First Name = ');
  157.         Locate (9,29);
  158.         Write ('     Class =  7. 1');
  159.         S.LName:='';
  160.         S.FName:='';
  161.         S.Class:=1;
  162.         S.Grade:=7;
  163.         Code:=1;
  164.         C:=True;
  165.         Repeat
  166.               Case Code Of
  167.                    0: Code:=4;
  168.                    5: Code:=1;
  169.               End;
  170.               Case Code Of
  171.                    1: SForm(S.LName,7,42,15,Code);
  172.                    2: SForm(S.FName,8,42,15,Code);
  173.                    3: IForm(S.Grade,9,42,12,Code);
  174.                    4: IForm(S.Class,9,45,12,Code);
  175.                   22: C:=True;
  176.               End;
  177.         Until ((Code=20) or (Code=22));
  178.         If Code=20 then C:=False;
  179.         If C=False then Begin
  180.            Sex:='M';
  181.            S220:='N';
  182.            Dis:='N';
  183.            Locate (11,28);
  184.            Write ('        Sex = M');
  185.            Locate (12,28);
  186.            Write ('220 Student = N');
  187.            Locate (13,28);
  188.            Write (' Disability = N');
  189.            Code:=1;
  190.            C:=True;
  191.            Repeat
  192.                 Case Code Of
  193.                      4: Code:=1;
  194.                      0: Code:=3;
  195.                 End;
  196.                 Case Code Of
  197.                      1: Repeat
  198.                               Code:=1;
  199.                               SForm(Sex,11,42,1,Code);
  200.                         Until ((Sex='M') or (Sex='m') or (Sex='F') or (Sex='f') or (Code=22));
  201.                      2: Repeat
  202.                               Code:=2;
  203.                               SForm(S220,12,42,1,Code);
  204.                         Until ((S220='N') or (S220='n') or (S220='Y') or (S220='y') or (Code=22));
  205.                      3: Repeat
  206.                               Code:=3;
  207.                               SForm(Dis,13,42,1,Code);
  208.                         Until ((Dis='N') or (Dis='n') or (Dis='Y') or (Dis='y') or (Code=22));
  209.                     22: C:=True;
  210.                 End;
  211.            Until ((Code=20) or (Code=22));
  212.            If Code=20 then C:=False;
  213.            If C=False then Begin
  214.               If ((Sex='M') or (Sex='m')) then S.Sex:=True else S.Sex:=False;
  215.               If ((S220='Y') or (Sex='y')) then S.S220:=True else S.S220:=False;
  216.               If ((Dis='Y') or (Sex='y')) then S.Dis:=True else S.Dis:=False;
  217.               InsertStudent(S,FileSize(StudentFile));
  218.               Reset (StudentFile);
  219.               Seek (StudentFile,FileSize(StudentFile));
  220.               Write (StudentFile,S);
  221.               Escape ('ESC - Main Menu');
  222.            End;
  223.         End;
  224.         If C=False then Begin
  225.            Locate (15,28);
  226.            Write ('Add another? (Y/N)');
  227.            Locate (23,80);
  228.            Hold;
  229.            R:=ReadKey;
  230.            If ((R='N') or (R='n')) then D:=True;
  231.            If ((R='-') or (R=#27)) then C:=True;
  232.         End;
  233.         If C=True then D:=True;
  234.      Until (D=True);
  235. End;
  236.  
  237. Procedure StudentUtils2(Top,Cur,High:Integer);
  238.  
  239. Var
  240.    Ptr:StudentPtr;
  241.    X,High2,Low:Integer;
  242.  
  243. Begin
  244.      Window (20,6,60,18);
  245.      Locate (1,1);
  246.      WriteLn (' LAST            FIRST            CLASS');
  247.      Ptr:=SFirst;
  248.      If Top<>1 then Begin
  249.         For X:=1 to Top-1 do Ptr:=Ptr^.Next;
  250.      End;
  251.      If Top+11>High then High2:=High else High2:=Top+11;
  252.      For X:=Top to High2 do Begin
  253.          If Cur=X then Begin
  254.             TextColor (0);
  255.             TextBackground (15);
  256.          End else Begin
  257.              TextColor (7);
  258.              TextBackground (0);
  259.          End;
  260.          Locate (X-Top+2,1);
  261.          Write ('                                     ');
  262.          Locate (X-Top+2,1);
  263.          Write (' ',Ptr^.LName);
  264.          Locate (X-Top+2,18);
  265.          Write (Ptr^.FName);
  266.          Locate (X-Top+2,36);
  267.          Write (Ptr^.Grade,'.',Ptr^.Class,' ');
  268.          Ptr:=Ptr^.Next;
  269.      End;
  270.      TextColor (7);
  271.      TextBackground (0);
  272.      Window (1,1,80,25);
  273.      Locate (23,80);
  274. End;
  275.  
  276. Procedure StudentUtils;
  277.  
  278. Var
  279.    Ptr:StudentPtr;
  280.    S:StudentRec;
  281.    I,X,High,Cur,High2,Code,Top:Integer;
  282.    Sex,S220,Dis:String;
  283.    C:Boolean;
  284.    R:Char;
  285.  
  286. Begin
  287.      Cls;
  288.      C:=False;
  289.      WorkBox(' STUDENT UTILITIES ');
  290.      Escape('ESC - Main Menu   F3 - Help Screen');
  291.      If SFirst=Nil then Begin
  292.         AddStudent(C);
  293.      End;
  294.      If C=False then Begin
  295.      Cur:=1;
  296.      Top:=1;
  297.      Repeat
  298.         Ptr:=SFirst;
  299.         High:=0;
  300.         While (Ptr<>Nil) do Begin
  301.               High:=High+1;
  302.               Ptr:=Ptr^.Next;
  303.         End;
  304.         If Cur<1 then Cur:=1;
  305.         If Cur>High then Cur:=High;
  306.         If Cur>Top+11 then Top:=Top+1;
  307.         If Cur<Top then Top:=Cur;
  308.         StudentUtils2(Top,Cur,High);
  309.         Hold;
  310.         R:=ReadKey;
  311.         Case R Of
  312.              #0: Begin
  313.                  R:=ReadKey;
  314.                  Case R Of
  315.                       #59: Begin
  316.                            AddStudent(C);
  317.                            Cls;
  318.                            End;
  319.  
  320.                       #60: Begin
  321.                            DeleteStudent(Cur);
  322.                            If High=1 then C:=True;
  323.                            Cls;
  324.                            End;
  325.  
  326.                       #61: Begin
  327.                            Cls;
  328.                            Locate (5,35);
  329.                            Write ('HELP SCREEN');
  330.                            Locate (7,15);
  331.                            Write (#24,#25,'   Use up and down arrows to move scroll bar.');
  332.                            Locate (9,15);
  333.                            Write (#17,#217,'   Press this while the scroll bar is on the');
  334.                            Locate (10,15);
  335.                            Write ('     record you want to edit and you will get the');
  336.                            Locate (11,15);
  337.                            Write ('     edit student screen.');
  338.                            Locate (13,15);
  339.                            Write ('F1   This will give you the new entry screen.  It');
  340.                            Locate (14,15);
  341.                            Write ('     will add the student on the end of the list.');
  342.                            Locate (16,15);
  343.                            Write ('F2   This will delete the record that the scroll');
  344.                            Locate (17,15);
  345.                            Write ('     bar is currently on.');
  346.                            Locate (23,80);
  347.                            Hold;
  348.                            R:=ReadKey;
  349.                            Cls;
  350.                            End;
  351.  
  352.                       #72: Cur:=Cur-1;
  353.                       #80: Cur:=Cur+1;
  354.                  End;
  355.                  End;
  356.  
  357.             #13: Begin
  358.                  EditStudent(Cur,C);
  359.                  Cls;
  360.                  End;
  361.  
  362.             '-',
  363.             #27: C:=True;
  364.         End;
  365.      Until (C=True);
  366.      End;
  367. End;
  368.  
  369. Procedure LoadCounselors;
  370.  
  371. Var
  372.    S:CounselorRec;
  373.    X:Integer;
  374.  
  375. Begin
  376.      Reset (CounselorFile);
  377.      X:=0;
  378.      While (Eof(CounselorFile)=False) do Begin
  379.            Read(CounselorFile,S);
  380.            If S.LName<>'Deleted' then InsertCounselor(S,X);
  381.            X:=X+1;
  382.      End;
  383. End;
  384.  
  385. Procedure EditCounselor(Cur:Integer; Var C:Boolean);
  386.  
  387. Var
  388.    Ptr:CounselorPtr;
  389.    Sex,S220,Dis:String;
  390.    S:CounselorRec;
  391.    X,Code:Integer;
  392.  
  393. Begin
  394.      Cls;
  395.      Escape ('ESC - Main Menu   F1 - Save Changes');
  396.      Ptr:=CFirst;
  397.      If Cur<>1 then Begin
  398.         For X:=1 to Cur-1 do Ptr:=Ptr^.Next;
  399.      End;
  400.      Reset (CounselorFile);
  401.      Seek (CounselorFile,Ptr^.FileLoc);
  402.      Read (CounselorFile,S);
  403.         Locate (7,29);
  404.         Write (' Last Name = ',S.LName);
  405.         Locate (8,29);
  406.         Write ('First Name = ',S.FName);
  407.         Locate (9,29);
  408.         Write ('     Grade = ',S.Grade:2);
  409.         Locate (10,29);
  410.         Write ('      Room = ',S.Room);
  411.         Code:=1;
  412.         C:=True;
  413.         Repeat
  414.               Case Code Of
  415.                    0: Code:=4;
  416.                    5: Code:=1;
  417.               End;
  418.               Case Code Of
  419.                    1: SForm(S.LName,7,42,15,Code);
  420.                    2: SForm(S.FName,8,42,15,Code);
  421.                    3: IForm(S.Grade,9,42,12,Code);
  422.                    4: SForm(S.Room,10,42,8,Code);
  423.                   22: C:=True;
  424.               End;
  425.         Until ((Code=20) or (Code=22));
  426.         If C=False then Begin
  427.               Reset (CounselorFile);
  428.               Seek (CounselorFile,Ptr^.FileLoc);
  429.               Write (CounselorFile,S);
  430.               Ptr^.LName:=S.LName;
  431.               Ptr^.FName:=S.FName;
  432.               Ptr^.Grade:=S.Grade;
  433.               Ptr^.Room:=S.Room;
  434.               Escape ('ESC - Main Menu');
  435.         End;
  436. End;
  437.  
  438. Procedure DeleteCounselor (Cur:Integer);
  439.  
  440. Var
  441.    Ptr:CounselorPtr;
  442.    X:Integer;
  443.    S:CounselorRec;
  444.  
  445. Begin
  446.      Ptr:=CFirst;
  447.      If Cur<>1 then Begin
  448.         For X:=1 to Cur-1 do Ptr:=Ptr^.Next;
  449.      End;
  450.      Reset (CounselorFile);
  451.      Seek (CounselorFile,Ptr^.FileLoc);
  452.      Read (CounselorFile,S);
  453.      S.LName:='Deleted';
  454.      Seek (CounselorFile,Ptr^.FileLoc);
  455.      Write (CounselorFile,S);
  456.      CFirst:=Nil;
  457.      CLast:=Nil;
  458.      LoadCounselors;
  459. End;
  460.  
  461. Procedure AddCounselor (Var C:Boolean);
  462.  
  463. Var
  464.    S:CounselorRec;
  465.    Code:Integer;
  466.    Sex,S220,Dis:String;
  467.    D:Boolean;
  468.    R:Char;
  469.  
  470. Begin
  471.      D:=False;
  472.      Repeat
  473.         Cls;
  474.         Escape ('ESC - Main Menu   F1 - Save Entry');
  475.         Locate (7,29);
  476.         Write (' Last Name = ');
  477.         Locate (8,29);
  478.         Write ('First Name = ');
  479.         Locate (9,29);
  480.         Write ('     Grade =  7');
  481.         Locate (10,29);
  482.         Write ('      Room = ');
  483.         S.LName:='';
  484.         S.FName:='';
  485.         S.Grade:=7;
  486.         S.Room:='';
  487.         Code:=1;
  488.         C:=True;
  489.         Repeat
  490.               Case Code Of
  491.                    0: Code:=4;
  492.                    5: Code:=1;
  493.               End;
  494.               Case Code Of
  495.                    1: SForm(S.LName,7,42,15,Code);
  496.                    2: SForm(S.FName,8,42,15,Code);
  497.                    3: IForm(S.Grade,9,42,12,Code);
  498.                    4: SForm(S.Room,10,42,8,Code);
  499.                   22: C:=True;
  500.               End;
  501.         Until ((Code=20) or (Code=22));
  502.         If Code=20 then C:=False;
  503.            If C=False then Begin
  504.               InsertCounselor(S,FileSize(CounselorFile));
  505.               Reset (CounselorFile);
  506.               Seek (CounselorFile,FileSize(CounselorFile));
  507.               Write (CounselorFile,S);
  508.               Escape ('ESC - Main Menu');
  509.            End;
  510.         If C=False then Begin
  511.            Locate (15,28);
  512.            Write ('Add another? (Y/N)');
  513.            Locate (23,80);
  514.            Hold;
  515.            R:=ReadKey;
  516.            If ((R='N') or (R='n')) then D:=True;
  517.            If ((R='-') or (R=#27)) then C:=True;
  518.         End;
  519.         If C=True then D:=True;
  520.      Until (D=True);
  521. End;
  522.  
  523. Procedure CounselorUtils2(Top,Cur,High:Integer);
  524.  
  525. Var
  526.    Ptr:CounselorPtr;
  527.    X,High2,Low:Integer;
  528.  
  529. Begin
  530.      Window (15,6,64,18);
  531.      Locate (1,1);
  532.               { _______  ________  ________  ________  ________ _}
  533.               {/   0   \/    1   \/    2   \/    3   \/    4   \5}
  534.               {12345678901234567890123456789012345678901234567890}
  535.      WriteLn (' LAST           FIRST           GRADE  ROOM');
  536.      Ptr:=CFirst;
  537.      If Top<>1 then Begin
  538.         For X:=1 to Top-1 do Ptr:=Ptr^.Next;
  539.      End;
  540.      If Top+11>High then High2:=High else High2:=Top+11;
  541.      For X:=Top to High2 do Begin
  542.          If Cur=X then Begin
  543.             TextColor (0);
  544.             TextBackground (15);
  545.          End else Begin
  546.              TextColor (7);
  547.              TextBackground (0);
  548.          End;
  549.          Locate (X-Top+2,1);
  550.          Write ('                                                ');
  551.          Locate (X-Top+2,1);
  552.          Write (' ',Ptr^.LName);
  553.          Locate (X-Top+2,17);
  554.          Write (Ptr^.FName);
  555.          Locate (X-Top+2,34);
  556.          Write (Ptr^.Grade:2,'    ',Ptr^.Room);
  557.          Ptr:=Ptr^.Next;
  558.      End;
  559.      TextColor (7);
  560.      TextBackground (0);
  561.      Window (1,1,80,25);
  562.      Locate (23,80);
  563. End;
  564.  
  565. Procedure CounselorUtils;
  566.  
  567. Var
  568.    Ptr:CounselorPtr;
  569.    S:CounselorRec;
  570.    I,X,High,Cur,High2,Code,Top:Integer;
  571.    Sex,S220,Dis:String;
  572.    C:Boolean;
  573.    R:Char;
  574.  
  575. Begin
  576.      Cls;
  577.      C:=False;
  578.      WorkBox(' COUNSELOR UTILITIES ');
  579.      Escape('ESC - Main Menu   F3 - Help Screen');
  580.      If CFirst=Nil then Begin
  581.         AddCounselor(C);
  582.         Cls;
  583.      End;
  584.      If C=False then Begin
  585.      Cur:=1;
  586.      Top:=1;
  587.      Repeat
  588.         Ptr:=CFirst;
  589.         High:=0;
  590.         While (Ptr<>Nil) do Begin
  591.               High:=High+1;
  592.               Ptr:=Ptr^.Next;
  593.         End;
  594.         If Cur<1 then Cur:=1;
  595.         If Cur>High then Cur:=High;
  596.         If Cur>Top+11 then Top:=Top+1;
  597.         If Cur<Top then Top:=Cur;
  598.         CounselorUtils2(Top,Cur,High);
  599.         Hold;
  600.         R:=ReadKey;
  601.         Case R Of
  602.              #0: Begin
  603.                  R:=ReadKey;
  604.                  Case R Of
  605.                       #59: Begin
  606.                            AddCounselor(C);
  607.                            Cls;
  608.                            End;
  609.  
  610.                       #60: Begin
  611.                            DeleteCounselor(Cur);
  612.                            If High=1 then C:=True;
  613.                            Cls;
  614.                            End;
  615.  
  616.                       #61: Begin
  617.                            Cls;
  618.                            Locate (5,35);
  619.                            Write ('HELP SCREEN');
  620.                            Locate (7,15);
  621.                            Write (#24,#25,'   Use up and down arrows to move scroll bar.');
  622.                            Locate (9,15);
  623.                            Write (#17,#217,'   Press this while the scroll bar is on the');
  624.                            Locate (10,15);
  625.                            Write ('     record you want to edit and you will get the');
  626.                            Locate (11,15);
  627.                            Write ('     edit counselor screen.');
  628.                            Locate (13,15);
  629.                            Write ('F1   This will give you the new entry screen.  It');
  630.                            Locate (14,15);
  631.                            Write ('     will add the counselor on the end of the list.');
  632.                            Locate (16,15);
  633.                            Write ('F2   This will delete the record that the scroll');
  634.                            Locate (17,15);
  635.                            Write ('     bar is currently on.');
  636.                            Locate (23,80);
  637.                            Hold;
  638.                            R:=ReadKey;
  639.                            Cls;
  640.                            End;
  641.  
  642.                       #72: Cur:=Cur-1;
  643.                       #80: Cur:=Cur+1;
  644.                  End;
  645.                  End;
  646.  
  647.             #13: Begin
  648.                  EditCounselor(Cur,C);
  649.                  Cls;
  650.                  End;
  651.  
  652.             '-',
  653.             #27: C:=True;
  654.         End;
  655.      Until (C=True);
  656.      End;
  657. End;
  658.  
  659. Procedure Sort;
  660.  
  661. Var
  662.    Ptr:StudentPtr;
  663.    E:StudentRec;
  664.    X,Num,Next:Integer;
  665.    CPtr:CounselorPtr;
  666.    CSex,C220,CDis:Boolean;
  667.  
  668. Begin
  669.      Reset(StudentFile);
  670.      Num:=0;
  671.      Next:=1;
  672.      CPtr:=CFirst;
  673.      While (CPtr<>Nil) do Begin
  674.            Num:=Num+1;
  675.            CPtr:=CPtr^.Next;
  676.      End;
  677.      For X:=1 to 8 do Begin
  678.          Ptr:=SFirst;
  679.          Case X Of
  680.               1: Begin        {Male, Normal}
  681.                  CSex:=True;
  682.                  C220:=False;
  683.                  CDis:=False;
  684.                  End;
  685.  
  686.               2: Begin        {Female, Normal}
  687.                  CSex:=False;
  688.                  C220:=False;
  689.                  CDis:=False;
  690.                  End;
  691.  
  692.               3: Begin        {Male, 220}
  693.                  CSex:=True;
  694.                  C220:=True;
  695.                  CDis:=False;
  696.                  End;
  697.  
  698.               4: Begin        {Female, 220}
  699.                  CSex:=False;
  700.                  C220:=True;
  701.                  CDis:=False;
  702.                  End;
  703.  
  704.               5: Begin        {Male, Dis.}
  705.                  CSex:=True;
  706.                  C220:=False;
  707.                  CDis:=True;
  708.                  End;
  709.  
  710.               6: Begin        {Female, Dis.}
  711.                  CSex:=False;
  712.                  C220:=False;
  713.                  CDis:=True;
  714.                  End;
  715.  
  716.               7: Begin        {Male, 220, Dis}
  717.                  CSex:=True;
  718.                  C220:=True;
  719.                  CDis:=True;
  720.                  End;
  721.  
  722.               8: Begin        {Female, 220, Dis}
  723.                  CSex:=False;
  724.                  C220:=True;
  725.                  CDis:=True;
  726.                  End;
  727.          End;
  728.          While (Ptr<>Nil) do Begin
  729.                Seek(StudentFile,Ptr^.FileLoc);
  730.                Read(StudentFile,E);
  731.                Locate (5,10);
  732.                Write (' ');
  733.                Locate (23,80);
  734.                If ((E.Sex=CSex) and (E.S220=C220) and (E.Dis=CDis)) then Begin
  735.                   InsertGroup (Next,Ptr^.FileLoc);
  736.                   Next:=Next+1;
  737.                   If Next>Num then Next:=1;
  738.                End;
  739.                Locate (5,10);
  740.                Write ('.');
  741.                Locate (23,80);
  742.                Ptr:=Ptr^.Next;
  743.          End;
  744.      End;
  745. End;
  746.  
  747. Procedure SortGroups;
  748.  
  749. Var
  750.    CPtr:CounselorPtr;
  751.    GPtr:GroupPtr;
  752.    Ptr:StudentPtr;
  753.    I,X:Integer;
  754.    C,D:Boolean;
  755.    R:Char;
  756.  
  757. Begin
  758.      Cls;
  759.      WorkBox(' SORT GROUPS ');
  760.      Escape('');
  761.      Locate (12,36);
  762.      Write ('Sorting...');
  763.      Locate (23,80);
  764.      Sort;
  765.      Cls;
  766.      Escape('ESC - Main Menu');
  767.      I:=1;
  768.      C:=False;
  769.      While ((C=False) and (CPtr<>Nil)) do Begin
  770.            D:=False;
  771.            Ptr:=SFirst;
  772.            Repeat
  773.                  Cls;
  774.                  Locate (6,10);
  775.                  Write (CPtr^.Room,'  ',CPtr^.LName,', ',CPtr^.FName);
  776.                  For X:=1 to 10 do Begin
  777.                      If Ptr=Nil then Begin
  778.                         X:=10;
  779.                         D:=True;
  780.                      End
  781.                      Else Begin
  782.                           Locate (7+X,5);
  783.                           Write (Ptr^.Grade,'-',Ptr^.Class);
  784.                           If Ptr^.Grade<10 then Write (' ');
  785.                           If Ptr^.Class<10 then Write (' ');
  786.                           Write (' ',Ptr^.LName,', ',Ptr^.FName);
  787.                      End;
  788.                      Ptr:=Ptr^.Next;
  789.                  End;
  790.                  If D=False then Begin
  791.                  For X:=1 to 10 do Begin
  792.                      If Ptr=Nil then Begin
  793.                         X:=10;
  794.                         D:=True;
  795.                      End
  796.                      Else Begin
  797.                           Locate (7+X,40);
  798.                           Write (Ptr^.Grade,'-',Ptr^.Class);
  799.                           If Ptr^.Grade<10 then Write (' ');
  800.                           If Ptr^.Class<10 then Write (' ');
  801.                           Write (' ',Ptr^.LName,', ',Ptr^.FName);
  802.                      End;
  803.                      Ptr:=Ptr^.Next;
  804.                  End;
  805.                  End;
  806.                  If Ptr=Nil then D:=True;
  807.                  If D=False then Begin
  808.                     Locate (19,5);
  809.                     Write ('Continued...');
  810.                  End;
  811.                  Locate (23,80);
  812.                  Hold;
  813.                  R:=ReadKey;
  814.                  If ((R='-') or (R=#27)) then C:=True;
  815.            Until ((D=True) or (C=True));
  816.      End;
  817. End;
  818.  
  819. Procedure PrintClassLists;
  820.  
  821. Var
  822.    R:Char;
  823.    Class,Grade,Code:Integer;
  824.    Ptr:StudentPtr;
  825.    C,D:Boolean;
  826.  
  827. Begin
  828.      Cls;
  829.      WorkBox(' PRINT CLASS LISTS ');
  830.      Escape('ESC - Print Menu');
  831.      Locate (10,25);
  832.      Write ('Press F1 to print all lists.');
  833.      Locate (11,25);
  834.      Write ('Press any key to print a');
  835.      Locate (12,25);
  836.      Write ('specific list.');
  837.      Locate (23,80);
  838.      Hold;
  839.      R:=ReadKey;
  840.      If (R=#0) then Begin
  841.               R:=ReadKey;
  842.               If R=#59 then Begin
  843.                  Cls;
  844.                  Grade:=1;
  845.                  Class:=1;
  846.                  Repeat
  847.                        D:=False;
  848.                        Ptr:=SFirst;
  849.                        While (Ptr<>Nil) do Begin
  850.                              If ((Ptr^.Grade=Grade) and (Ptr^.Class=Class)) then Begin
  851.                                 If D=False then Begin
  852.                                    D:=True;
  853.                                    WriteLn(Lst);
  854.                                    WriteLn(Lst,'          CLASS: ',Grade,'-',Class);
  855.                                    WriteLn(Lst);
  856.                                 End;
  857.                                 WriteLn(Lst,'          ',Ptr^.LName,', ',Ptr^.FName);
  858.                              End;
  859.                              Ptr:=Ptr^.Next;
  860.                        End;
  861.                        If D=True then Write(Lst,#12);
  862.                        Class:=Class+1;
  863.                        If Class=13 then Begin
  864.                           Class:=1;
  865.                           Grade:=Grade+1;
  866.                        End;
  867.                  Until (Grade=13);
  868.               End;
  869.               End;
  870.      If ((R<>#59) and (R<>'-') and (R<>#27)) then Begin
  871.               Cls;
  872.               Locate (12,30);
  873.               Write ('Enter class number:');
  874.               Locate (13,38);
  875.               Write (' 7. 1');
  876.               Class:=1;
  877.               Grade:=7;
  878.               Code:=1;
  879.               Repeat
  880.                     Case Code Of
  881.                          0: Code:=2;
  882.                          3: Code:=1;
  883.                     End;
  884.                     Case Code Of
  885.                          1: IForm(Grade,13,38,12,Code);
  886.                          2: IForm(Class,13,41,12,Code);
  887.                     End;
  888.               Until ((Code=20) or (Code=22));
  889.               If Code=20 then Begin
  890.                  Ptr:=SFirst;
  891.                  D:=False;
  892.                  While (Ptr<>Nil) do Begin
  893.                        If ((Ptr^.Class=Class) and (Ptr^.Grade=Grade)) then Begin
  894.                           If D=False then Begin
  895.                              D:=True;
  896.                              WriteLn(Lst,'           CLASS: ',Grade,'-',Class);
  897.                              WriteLn(Lst);
  898.                           End;
  899.                           WriteLn(Lst,'          ',Ptr^.LName,', ',Ptr^.FName);
  900.                        End;
  901.                        Ptr:=Ptr^.Next;
  902.                  End;
  903.                  If D=True then Write(Lst,#12);
  904.               End;
  905.      End;
  906. End;
  907.  
  908. Procedure PrintCounselorList;
  909.  
  910. Var
  911.    R:Char;
  912.    Ptr:CounselorPtr;
  913.    I:Integer;
  914.  
  915. Begin
  916.      Cls;
  917.      WorkBox(' PRINT COUNSELOR LIST ');
  918.      Escape('ESC - Counselor Menu');
  919.      Locate (10,30);
  920.      Write ('Press F1 to print');
  921.      Locate (11,30);
  922.      Write ('the counselor list');
  923.      Locate (23,80);
  924.      Hold;
  925.      R:=ReadKey;
  926.      If R=#0 then Begin
  927.         R:=ReadKey;
  928.         If R=#59 then Begin
  929.            Cls;
  930.            Locate (23,80);
  931.            Ptr:=CFirst;
  932.            WriteLn(Lst,'         COUNSELOR LIST');
  933.            WriteLn(Lst);
  934.            WriteLn(Lst,'         GRD ROOM      NAME');
  935.            While (Ptr<>Nil) do Begin
  936.                  Write(Lst,'          ',Ptr^.Grade:2,'  ',Ptr^.Room);
  937.                  For I:=(Length(Ptr^.Room)) to 8 do
  938.                      Write(Lst,' ');
  939.                  WriteLn(Lst,Ptr^.LName,', ',Ptr^.FName);
  940.                  Ptr:=Ptr^.Next;
  941.            End;
  942.            Write(Lst,#12);
  943.         End;
  944.      End;
  945. End;
  946.  
  947. Procedure PrintMenu;
  948.  
  949. Var
  950.    R:Char;
  951.    C:Boolean;
  952.  
  953. Begin
  954. Repeat
  955.      C:=False;
  956.      Cls;
  957.      WorkBox (' PRINT MENU ');
  958.      Escape ('ESC - Main Menu');
  959.      Locate (10,30);
  960.      Write ('1) Print Class Lists');
  961.      Locate (12,30);
  962.      Write ('2) Print Counselor List');
  963.      Locate (14,30);
  964.      Write ('3) Print Group Lists');
  965.      Locate (23,80);
  966.      Hold;
  967.      R:=ReadKey;
  968.      Case R Of
  969.           '-',
  970.           #27: C:=True;
  971.  
  972.           '1': PrintClassLists;
  973.           '2': PrintCounselorList;
  974.      End;
  975. Until (C=True);
  976. End;
  977.  
  978. Procedure MainMenu;
  979.  
  980. Var
  981.    R:Char;
  982.    C:Boolean;
  983.  
  984. Begin
  985. Repeat
  986.      Cls;
  987.      C:=False;
  988.      WorkBox(' MAIN MENU ');
  989.      Escape ('ESC - Exit Program');
  990.      Locate (9,30);
  991.      Write ('1) Student Utilities');
  992.      Locate (11,30);
  993.      Write ('2) Counselor Utilities');
  994.      Locate (13,30);
  995.      Write ('3) Sort Groups');
  996.      Locate (15,30);
  997.      Write ('4) Print Menu');
  998.      Locate (23,80);
  999.      Hold;
  1000.      R:=ReadKey;
  1001.      Case R Of
  1002.           '-',
  1003.           #27: C:=True;
  1004.  
  1005.           '1': StudentUtils;
  1006.           '2': CounselorUtils;
  1007.           '3': SortGroups;
  1008.           '4': PrintMenu;
  1009.      End;
  1010. Until (C=True);
  1011. End;
  1012.  
  1013. Begin
  1014. ClrScr;
  1015. SFirst:=Nil;
  1016. SLast:=Nil;
  1017. CFirst:=Nil;
  1018. CLast:=Nil;
  1019. Assign (StudentFile,'Advisor2.Dat');
  1020. Assign (CounselorFile,'Advisor2.Stp');
  1021. LoadStudents;
  1022. LoadCounselors;
  1023. MainMenu;
  1024. ClrScr;
  1025. Close (StudentFile);
  1026. End.